home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CICA 1994 April
/
CICA Shareware for Windows CD-ROM (Walnut Creek CD-ROM)(April 1994).ISO
/
win3
/
programr
/
vbasic
/
health.exe
/
EXITSAVE.FRM
< prev
next >
Wrap
Text File
|
1993-07-22
|
6KB
|
220 lines
VERSION 2.00
Begin Form exitsave
BackColor = &H00808000&
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 3765
ClientLeft = 2715
ClientTop = 1500
ClientWidth = 4095
Height = 4170
Left = 2655
LinkMode = 1 'Source
LinkTopic = "Form1"
ScaleHeight = 3765
ScaleWidth = 4095
Top = 1155
Width = 4215
Begin CommandButton Command1
Caption = "Cancel"
Height = 375
Index = 2
Left = 2880
TabIndex = 3
Top = 3240
Width = 975
End
Begin CommandButton Command1
Caption = "Exit"
Height = 375
Index = 1
Left = 1560
TabIndex = 2
Top = 3240
Width = 975
End
Begin CommandButton Command1
Caption = "Save"
Enabled = 0 'False
Height = 375
Index = 0
Left = 240
TabIndex = 1
Top = 3240
Width = 975
End
Begin Timer Timer1
Left = 360
Top = 2520
End
Begin PictureBox Picture1
BackColor = &H00808000&
BorderStyle = 0 'None
Height = 2175
Index = 0
Left = 1440
Picture = EXITSAVE.FRX:0000
ScaleHeight = 2175
ScaleWidth = 1215
TabIndex = 0
Top = 840
Width = 1215
End
Begin PictureBox Picture1
BackColor = &H00808000&
BorderStyle = 0 'None
Height = 2175
Index = 2
Left = 2880
Picture = EXITSAVE.FRX:12F0
ScaleHeight = 2175
ScaleWidth = 1215
TabIndex = 5
Top = 0
Visible = 0 'False
Width = 1215
End
Begin PictureBox Picture1
BackColor = &H00808000&
BorderStyle = 0 'None
Height = 2175
Index = 1
Left = 0
Picture = EXITSAVE.FRX:25E0
ScaleHeight = 2175
ScaleWidth = 1215
TabIndex = 4
Top = 0
Visible = 0 'False
Width = 1215
End
End
Sub Command1_Click (Index As Integer)
Select Case Index
Case 0
If command1(0).caption = "New" Then
admit.picture1.tag = "new"
command1(0).caption = "Save"
command1(2).caption = "Cancel"
timer1.interval = 1
timer1.enabled = -1
Else
picture1(0).picture = picture1(1).picture
Cls
msg$ = "Data Saved"
currenty = 0
currentx = (exitsave.scalewidth - TextWidth(msg$)) / 2
Print msg$
msg$ = "Patient Number " + Str$(curpatID)
currentx = (exitsave.scalewidth - TextWidth(msg$)) / 2
Print msg$
picture1(0).Refresh
exitsave.Refresh
screen.mousepointer = 11
saveproc
screen.mousepointer = 0
command1(0).caption = "New"
command1(1).caption = "Exit"
admit.picture2.tag = "Exit"
command1(2).caption = "Continue"
admit.picture1.tag = ""
End If
Case 1
If command1(1).caption = "Exit" Then
'If TYPECHECK Then
'If FINALCHECK Then
msg$ = "Are You Sure You Want to Exit?"
x% = MsgBox(msg$, 3, "DISPOSITION DIALOG")
If x% = 6 Then
timer1.interval = 1
timer1.enabled = -1
Endroutine
End If
If x% = 2 Then
timer1.interval = 1
timer1.enabled = -1
End If
'End If
'End If
End If
If command1(1).caption = "Clear" Then
msg$ = "Clear All Patient Data Now?"
x% = MsgBox(msg$, 4, "DISPOSITION DIALOG")
If x% = 6 Then
clearoutine
Cls
msg$ = "All Patient Data Cleared"
currenty = 0
currentx = (exitsave.scalewidth - TextWidth(msg$)) / 2
Print msg$
msg$ = "Patient Number " + Str$(curpatID)
currentx = (exitsave.scalewidth - TextWidth(msg$)) / 2
Print msg$
picture1(0).picture = picture1(2).picture
admit.picture1.tag = "new"
timer1.interval = 1600
timer1.enabled = -1
End If
admit.picture2.tag = "Exit"
End If
Case 2
If command1(2).caption = "Continue" Then
Cls
msg$ = "File Reopened"
currenty = 0
currentx = (exitsave.scalewidth - TextWidth(msg$)) / 2
Print msg$
msg$ = "Patient Number " + Str$(patientID(1))
currentx = (exitsave.scalewidth - TextWidth(msg$)) / 2
Print msg$
picture1(0).picture = picture1(2).picture
timer1.interval = 1300
timer1.enabled = -1
Else
timer1.interval = 1
timer1.enabled = -1
End If
End Select
End Sub
Sub Form_Load ()
If TYPECHECK Then
command1(0).enabled = -1
Else
command1(0).enabled = 0
End If
autoredraw = -1
forecolor = QBColor(15)
fontname = "ms sans serif"
fontsize = 12
command1(1).caption = admit.picture2.tag
If command1(1).caption = "Clear" Then
msg$ = "Wipe The Current Patient Data?"
Else
command1(1).caption = "Exit"
msg$ = "Save The Current Patient Data?"
End If
currenty = 0
currentx = (exitsave.scalewidth - TextWidth(msg$)) / 2
Print msg$
End Sub
Sub Timer1_Timer ()
Static secondtime As Integer
exitsave.visible = 0
If secondtime Then
timer1.enabled = 0
secondtime = 0
Unload exitsave
Exit Sub
End If
timer1.interval = 357
secondtime = -1
End Sub